home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Prog / D-G / FORTRAN Goodies / ReadAllFiles.txt < prev    next >
Encoding:
Text File  |  1990-11-19  |  1.5 KB  |  67 lines  |  [TEXT/MPS ]
  1. !!G toolbox.finc
  2. !!MP inlines.f
  3.  
  4. C    This program creates an array of all the file names in the folder 
  5. C    of the selected file.
  6. C
  7. c    Example provided for owners of Language Systems FORTRAN
  8. c    © 1990 Language Systems Corp.
  9.  
  10.     Integer*4 NewVRefNum, filecount
  11.     Character*30 filelist(300)
  12.     
  13.     open(1,file=*, status = 'old') !User selects any file in the folder
  14.     NewVRefNum = JVREFNUM(1)
  15.     close(1)
  16.     Call GetFiles(NewVRefNum, filelist, filecount)
  17.     Do I = 1,filecount
  18.         !open(1,file=filelist(i), status= 'old')
  19.         ! do whatever you want
  20.         !close(1)
  21.         write(*,*) filelist(i)
  22.     End Do
  23.     end
  24.     
  25.     Subroutine GetFiles(Vrefnum,list,count)
  26.     Integer*4 VRefNum, count
  27.     Integer*2 idx
  28.     Character*30 list(*)
  29.     String*255 fname
  30.     Character*255 tempname
  31.     Record /HParamBlockRec/ HPB
  32.     count = 0
  33.     ioserr = noerr
  34.     idx = 1
  35.     Do While (ioserr = noerr)
  36.         HPB.ioCompletion = nil
  37.         HPB.ionamePtr = %loc(fname)
  38.         HPB.ioVRefNum = Vrefnum
  39.         HPB.ioFVersNum = 0
  40.         HPB.ioFDirIndex = idx
  41.         ioserr = PBGetFInfo(%ref(HPB),INT2(0))
  42.         if (ioserr = noerr) then
  43.             tempname = fname
  44.             Call UpperCase(tempname)
  45.             fname = tempname
  46.             !Test fname for the extension you want, or proper length, etc.
  47.             !If it meets your criteria, then
  48.                 count = count + 1
  49.                 list(count) = fname
  50.             !In any case,
  51.             idx = idx + 1
  52.         end if
  53.     End Do
  54.     return
  55.     end
  56.     
  57.     Subroutine UpperCase(thestring)
  58.     Character*(*) thestring
  59.     Do I = 1,Len(thestring)
  60.         j = ICHAR(thestring(i:i))
  61.         if ((j .GE. 97) .AND. (j .LE. 122)) then    !Is j a lower case letter?
  62.             thestring(i:i) = CHAR(j-32)
  63.         end if
  64.     End Do
  65.     return
  66.     end
  67.